home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / macscripts / find2perl < prev    next >
Text File  |  1993-10-23  |  12KB  |  572 lines
  1. Perl -Sx "{0}" {"Parameters"}
  2. Exit
  3.  
  4. #!/usr/local/bin/perl
  5.  
  6. $bin = "/usr/local/bin";
  7.  
  8. while ($ARGV[0] =~ /^[^-!(]/) {
  9.     push(@roots, shift);
  10. }
  11. @roots = (':') unless @roots;
  12. for (@roots) { unless (/:/) { $_ = ":" . $_; } $_ = "e($_); }
  13. $roots = join(',', @roots);
  14.  
  15. $indent = 1;
  16.  
  17. while (@ARGV) {
  18.     $_ = shift;
  19.     s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
  20.     if ($_ eq '(') {
  21.     $out .= &tab . "(\n";
  22.     $indent++;
  23.     next;
  24.     }
  25.     elsif ($_ eq ')') {
  26.     $indent--;
  27.     $out .= &tab . ")";
  28.     }
  29.     elsif ($_ eq '!') {
  30.     $out .= &tab . "!";
  31.     next;
  32.     }
  33.     elsif ($_ eq 'name') {
  34.     $out .= &tab;
  35.     $pat = &fileglob_to_re(shift);
  36.     $out .= '/' . $pat . "/";
  37.     }
  38.     elsif ($_ eq 'perm') {
  39.     $onum = shift;
  40.     die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
  41.     if ($onum =~ s/^-//) {
  42.         $onum = '0' . sprintf("%o", oct($onum) & 017777);    # s/b 07777 ?
  43.         $out .= &tab . "((\$mode & $onum) == $onum)";
  44.     }
  45.     else {
  46.         $onum = '0' . $onum unless $onum =~ /^0/;
  47.         $out .= &tab . "((\$mode & 0777) == $onum)";
  48.     }
  49.     }
  50.     elsif ($_ eq 'type') {
  51.     ($filetest = shift) =~ tr/s/S/;
  52.     $out .= &tab . "-$filetest _";
  53.     }
  54.     elsif ($_ eq 'print') {
  55.     $out .= &tab . 'print("$name\n")';
  56.     }
  57.     elsif ($_ eq 'print0') {
  58.     $out .= &tab . 'print("$name\0")';
  59.     }
  60.     elsif ($_ eq 'fstype') {
  61.     $out .= &tab;
  62.     $type = shift;
  63.     if ($type eq 'nfs')
  64.         { $out .= '$dev < 0'; }
  65.     else
  66.         { $out .= '$dev >= 0'; }
  67.     }
  68.     elsif ($_ eq 'user') {
  69.     $uname = shift;
  70.     $out .= &tab . "\$uid == \$uid{'$uname'}";
  71.     $inituser++;
  72.     }
  73.     elsif ($_ eq 'group') {
  74.     $gname = shift;
  75.     $out .= &tab . "\$gid == \$gid{'$gname'}";
  76.     $initgroup++;
  77.     }
  78.     elsif ($_ eq 'nouser') {
  79.     $out .= &tab . '!defined $uid{$uid}';
  80.     $inituser++;
  81.     }
  82.     elsif ($_ eq 'nogroup') {
  83.     $out .= &tab . '!defined $gid{$gid}';
  84.     $initgroup++;
  85.     }
  86.     elsif ($_ eq 'links') {
  87.     $out .= &tab . '$nlink ' . &n(shift);
  88.     }
  89.     elsif ($_ eq 'inum') {
  90.     $out .= &tab . '$ino ' . &n(shift);
  91.     }
  92.     elsif ($_ eq 'size') {
  93.     $out .= &tab . 'int((-s _ + 511) / 512) ' . &n(shift);
  94.     }
  95.     elsif ($_ eq 'atime') {
  96.     $out .= &tab . 'int(-A _) ' . &n(shift);
  97.     }
  98.     elsif ($_ eq 'mtime') {
  99.     $out .= &tab . 'int(-M _) ' . &n(shift);
  100.     }
  101.     elsif ($_ eq 'ctime') {
  102.     $out .= &tab . 'int(-C _) ' . &n(shift);
  103.     }
  104.     elsif ($_ eq 'exec') {
  105.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  106.     shift;
  107.     $_ = "@cmd";
  108.     if (m#^(/bin/)?rm -f {}$#) {
  109.         if (!@ARGV) {
  110.         $out .= &tab . 'unlink($_)';
  111.         }
  112.         else {
  113.         $out .= &tab . '(unlink($_) || 1)';
  114.         }
  115.     }
  116.     elsif (m#^(/bin/)?rm {}$#) {
  117.         $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
  118.     }
  119.     else {
  120.         for (@cmd) { s/'/\\'/g; }
  121.         $" = "','";
  122.         $out .= &tab . "&exec(0, '@cmd')";
  123.         $" = ' ';
  124.         $initexec++;
  125.     }
  126.     }
  127.     elsif ($_ eq 'ok') {
  128.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  129.     shift;
  130.     for (@cmd) { s/'/\\'/g; }
  131.     $" = "','";
  132.     $out .= &tab . "&exec(1, '@cmd')";
  133.     $" = ' ';
  134.     $initexec++;
  135.     }
  136.     elsif ($_ eq 'prune') {
  137.     $out .= &tab . '($prune = 1)';
  138.     }
  139.     elsif ($_ eq 'xdev') {
  140.     $out .= &tab . '(($prune |= ($dev != $topdev)),1)';
  141.     }
  142.     elsif ($_ eq 'newer') {
  143.     $out .= &tab;
  144.     $file = shift;
  145.     $newername = 'AGE_OF' . $file;
  146.     $newername =~ s/[^\w]/_/g;
  147.     $newername = '$' . $newername;
  148.     $out .= "-M _ < $newername";
  149.     $initnewer .= "$newername = -M " . "e($file) . ";\n";
  150.     }
  151.     elsif ($_ eq 'eval') {
  152.     $prog = "e(shift);
  153.     $out .= &tab . "eval $prog";
  154.     }
  155.     elsif ($_ eq 'depth') {
  156.     $depth++;
  157.     next;
  158.     }
  159.     elsif ($_ eq 'ls') {
  160.     $out .= &tab . "&ls";
  161.     $initls++;
  162.     }
  163.     elsif ($_ eq 'tar') {
  164.     $out .= &tab;
  165.     die "-tar must have a filename argument\n" unless @ARGV;
  166.     $file = shift;
  167.     $fh = 'FH' . $file;
  168.     $fh =~ s/[^\w]/_/g;
  169.     $out .= "&tar($fh)";
  170.     $file = '>' . $file;
  171.     $initfile .= "open($fh, " . "e($file) .
  172.       qq{) || die "Can't open $fh: \$!\\n";\n};
  173.     $inittar++;
  174.     $flushall = "\n&tflushall;\n";
  175.     }
  176.     elsif (/^n?cpio$/) {
  177.     $depth++;
  178.     $out .= &tab;
  179.     die "-$_ must have a filename argument\n" unless @ARGV;
  180.     $file = shift;
  181.     $fh = 'FH' . $file;
  182.     $fh =~ s/[^\w]/_/g;
  183.     $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
  184.     $file = '>' . $file;
  185.     $initfile .= "open($fh, " . "e($file) .
  186.       qq{) || die "Can't open $fh: \$!\\n";\n};
  187.     $initcpio++;
  188.     $flushall = "\n&flushall;\n";
  189.     }
  190.     else {
  191.     die "Unrecognized switch: -$_\n";
  192.     }
  193.     if (@ARGV) {
  194.     if ($ARGV[0] eq '-o') {
  195.         { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
  196.         $statdone = 0 if $indent == 1 && $delayedstat;
  197.         $saw_or++;
  198.         shift;
  199.     }
  200.     else {
  201.         $out .= " &&" unless $ARGV[0] eq ')';
  202.         $out .= "\n";
  203.         shift if $ARGV[0] eq '-a';
  204.     }
  205.     }
  206. }
  207.  
  208. print <<"END";
  209. # Macintosh MPW shell startup hack
  210. Perl -Sx "{0}" {"Parameters"}
  211. Exit
  212.   
  213. #!$bin/perl
  214.  
  215. END
  216.  
  217. if ($initls) {
  218.     print <<'END';
  219. @rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
  220. @moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
  221.  
  222. END
  223. }
  224.  
  225. # The Mac can't handle this
  226. #
  227. # if ($inituser || $initls) {
  228. #     print 'while (($name, $pw, $uid) = getpwent) {', "\n";
  229. #     print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
  230. #     print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
  231. #     print "}\n\n";
  232. # }
  233. # 
  234. # if ($initgroup || $initls) {
  235. #     print 'while (($name, $pw, $gid) = getgrent) {', "\n";
  236. #     print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
  237. #     print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
  238. #     print "}\n\n";
  239. # }
  240.  
  241. print $initnewer, "\n" if $initnewer;
  242.  
  243. print $initfile, "\n" if $initfile;
  244.  
  245. $find = $depth ? "finddepth" : "find";
  246. print <<"END";
  247. require "$find.pl";
  248.  
  249. # Traverse desired filesystems
  250.  
  251. &$find($roots);
  252. $flushall
  253. exit;
  254.  
  255. sub wanted {
  256. $out;
  257. }
  258.  
  259. END
  260.  
  261. if ($initexec) {
  262.     print <<'END';
  263. sub exec {
  264.     local($ok, @cmd) = @_;
  265.     foreach $word (@cmd) {
  266.     $word =~ s#{}#$name#g;
  267.     }
  268.     if ($ok) {
  269.     local($old) = select(STDOUT);
  270.     $| = 1;
  271.     print "@cmd";
  272.     select($old);
  273.     return 0 unless <STDIN> =~ /^y/;
  274.     }
  275.     chdir $cwd;        # sigh
  276.     system @cmd;
  277.     chdir $dir;
  278.     return !$?;
  279. }
  280.  
  281. END
  282. }
  283.  
  284. if ($initls) {
  285.     print <<'END';
  286. sub ls {
  287.     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
  288.       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  289.  
  290.     $pname = $name;
  291.  
  292.     if (defined $blocks) {
  293.     $blocks = int(($blocks + 1) / 2);
  294.     }
  295.     else {
  296.     $blocks = int(($size + 1023) / 1024);
  297.     }
  298.  
  299.     if    (-f _) { $perms = '-'; }
  300.     elsif (-d _) { $perms = 'd'; }
  301.     elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
  302.     elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
  303.     elsif (-p _) { $perms = 'p'; }
  304.     elsif (-S _) { $perms = 's'; }
  305.     else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
  306.  
  307.     $tmpmode = $mode;
  308.     $tmp = $rwx[$tmpmode & 7];
  309.     $tmpmode >>= 3;
  310.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  311.     $tmpmode >>= 3;
  312.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  313.     substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
  314.     substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
  315.     substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
  316.     $perms .= $tmp;
  317.  
  318. #    $user = $user{$uid} || $uid;
  319. #    $group = $group{$gid} || $gid;
  320.  
  321.     ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
  322.     $moname = $moname[$mon];
  323.     if (-M _ > 365.25 / 2) {
  324.     $timeyear = '19' . $year;
  325.     }
  326.     else {
  327.     $timeyear = sprintf("%02d:%02d", $hour, $min);
  328.     }
  329.  
  330. #    printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
  331. #    printf "%5lu %4ld %-10s %2d %8s %s %2d %5s %s\n",
  332.         $ino,
  333.          $blocks,
  334.               $perms,
  335.                 $nlink,
  336. #                $user,
  337. #                     $group,
  338.                       $sizemm,
  339.                           $moname,
  340.                          $mday,
  341.                              $timeyear,
  342.                              $pname;
  343.     1;
  344. }
  345.  
  346. sub sizemm {
  347.     sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
  348. }
  349.  
  350. END
  351. }
  352.  
  353. if ($initcpio) {
  354. print <<'END';
  355. sub cpio {
  356.     local($nc,$fh) = @_;
  357.     local($text);
  358.  
  359.     if ($name eq 'TRAILER!!!') {
  360.     $text = '';
  361.     $size = 0;
  362.     }
  363.     else {
  364.     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  365.       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  366.     if (-f _) {
  367.         open(IN, "./$_\0") || do {
  368.         warn "Couldn't open $name: $!\n";
  369.         return;
  370.         };
  371.     }
  372.     else {
  373.         $text = readlink($_);
  374.         $size = 0 unless defined $text;
  375.     }
  376.     }
  377.  
  378.     ($nm = $name) =~ s#^\./##;
  379.     $nc{$fh} = $nc;
  380.     if ($nc eq 'n') {
  381.     $cpout{$fh} .=
  382.       sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
  383.         070707,
  384.         $dev & 0777777,
  385.         $ino & 0777777,
  386.         $mode & 0777777,
  387.         $uid & 0777777,
  388.         $gid & 0777777,
  389.         $nlink & 0777777,
  390.         $rdev & 0177777,
  391.         $mtime,
  392.         length($nm)+1,
  393.         $size,
  394.         $nm);
  395.     }
  396.     else {
  397.     $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
  398.     $cpout{$fh} .= pack("SSSSSSSSLSLa*",
  399.         070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
  400.         length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
  401.     }
  402.     if ($text ne '') {
  403.     $cpout{$fh} .= $text;
  404.     }
  405.     elsif ($size) {
  406.     &flush($fh) while ($l = length($cpout{$fh})) >= 5120;
  407.     while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
  408.         &flush($fh);
  409.         $l = length($cpout{$fh});
  410.     }
  411.     }
  412.     close IN;
  413. }
  414.  
  415. sub flush {
  416.     local($fh) = @_;
  417.  
  418.     while (length($cpout{$fh}) >= 5120) {
  419.     syswrite($fh,$cpout{$fh},5120);
  420.     ++$blocks{$fh};
  421.     substr($cpout{$fh}, 0, 5120) = '';
  422.     }
  423. }
  424.  
  425. sub flushall {
  426.     $name = 'TRAILER!!!';
  427.     foreach $fh (keys %cpout) {
  428.     &cpio($nc{$fh},$fh);
  429.     $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
  430.     &flush($fh);
  431.     print $blocks{$fh} * 10, " blocks\n";
  432.     }
  433. }
  434.  
  435. END
  436. }
  437.  
  438. if ($inittar) {
  439. print <<'END';
  440. sub tar {
  441.     local($fh) = @_;
  442.     local($linkname,$header,$l,$slop);
  443.     local($linkflag) = "\0";
  444.  
  445.     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  446.       $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  447.     $nm = $name;
  448.     if ($nlink > 1) {
  449.     if ($linkname = $linkseen{$fh,$dev,$ino}) {
  450.         $linkflag = 1;
  451.     }
  452.     else {
  453.         $linkseen{$fh,$dev,$ino} = $nm;
  454.     }
  455.     }
  456.     if (-f _) {
  457.     open(IN, "./$_\0") || do {
  458.         warn "Couldn't open $name: $!\n";
  459.         return;
  460.     };
  461.     $size = 0 if $linkflag ne "\0";
  462.     }
  463.     else {
  464.     $linkname = readlink($_);
  465.     $linkflag = 2 if defined $linkname;
  466.     $nm .= '/' if -d _;
  467.     $size = 0;
  468.     }
  469.  
  470.     $header = pack("a100a8a8a8a12a12a8a1a100",
  471.     $nm,
  472.     sprintf("%6o ", $mode & 0777),
  473.     sprintf("%6o ", $uid & 0777777),
  474.     sprintf("%6o ", $gid & 0777777),
  475.     sprintf("%11o ", $size),
  476.     sprintf("%11o ", $mtime),
  477.     "        ",
  478.     $linkflag,
  479.     $linkname);
  480.     $l = length($header) % 512;
  481.     substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
  482.     substr($header, 154, 1) = "\0";  # blech
  483.     $tarout{$fh} .= $header;
  484.     $tarout{$fh} .= "\0" x (512 - $l) if $l;
  485.     if ($size) {
  486.     &tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
  487.     while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
  488.         $slop = length($tarout{$fh}) % 512;
  489.         $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
  490.         &tflush($fh);
  491.         $l = length($tarout{$fh});
  492.     }
  493.     }
  494.     close IN;
  495. }
  496.  
  497. sub tflush {
  498.     local($fh) = @_;
  499.  
  500.     while (length($tarout{$fh}) >= 10240) {
  501.     syswrite($fh,$tarout{$fh},10240);
  502.     ++$blocks{$fh};
  503.     substr($tarout{$fh}, 0, 10240) = '';
  504.     }
  505. }
  506.  
  507. sub tflushall {
  508.     local($len);
  509.  
  510.     foreach $fh (keys %tarout) {
  511.     $len = 10240 - length($tarout{$fh});
  512.     $len += 10240 if $len < 1024;
  513.     $tarout{$fh} .= "\0" x $len;
  514.     &tflush($fh);
  515.     }
  516. }
  517.  
  518. END
  519. }
  520.  
  521. exit;
  522.  
  523. ############################################################################
  524.  
  525. sub tab {
  526.     local($tabstring);
  527.  
  528.     $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
  529.     if (!$statdone) {
  530.     if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
  531.         $delayedstat++;
  532.     }
  533.     else {
  534.         if ($saw_or) {
  535.         $tabstring .= <<'ENDOFSTAT' . $tabstring;
  536. ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  537. ENDOFSTAT
  538.         }
  539.         else {
  540.         $tabstring .= <<'ENDOFSTAT' . $tabstring;
  541. (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  542. ENDOFSTAT
  543.         }
  544.         $statdone = 1;
  545.     }
  546.     }
  547.     $tabstring =~ s/^\s+/ / if $out =~ /!$/;
  548.     $tabstring;
  549. }
  550.  
  551. sub fileglob_to_re {
  552.     local($tmp) = @_;
  553.  
  554.     $tmp =~ s/([.^\$()])/\\$1/g;
  555.     $tmp =~ s/([?*])/.$1/g;
  556.     "^$tmp$";
  557. }
  558.  
  559. sub n {
  560.     local($n) = @_;
  561.  
  562.     $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
  563.     $n =~ s/ 0*(\d)/ $1/;
  564.     $n;
  565. }
  566.  
  567. sub quote {
  568.     local($string) = @_;
  569.     $string =~ s/'/\\'/;
  570.     "'$string'";
  571. }
  572.